(** 
    Definitions for the primitive, exogenously defined functions within the Gnarly language, as well as ancilliary functions supporting them and the
    definitions of the initial Gnarly execution and typing environments containing these functions.
    @author mmvitousek
*)

open Gnsyn
open List
open Printing
open Interp
open Sinterp
open Interface
exception TooManyArgs
exception TooFewArgs

(** Factorial function *)
let rec factorial_ocaml number = 
	if number <= 1 then 1 else number * factorial_ocaml (number - 1)
(** Exponentiation over integers *)
and exponent_ocaml base power = 
	if power = 0 then 1 else base * exponent_ocaml base (power - 1)
(**
   Reads a line of input from the user and converts it into a {i gnvalue}.
   @param env the current execution environment
   @param operandl the list of operands (expected to have zero elements)
   @param cexp the {i gnexp} being evaluated
   @return a {i gnvalue} expressing the string inputted by the user
*)
and g_read env operandl cexp =
	if (length operandl) > 0 then
		raise TooManyArgs
	else print_fix "> "; make_gnstring (read_line ())
(**
   Returns the factorial of the input given in {b operandl}.
   @param env the current execution environment
   @param operandl the list of operands (expected to have one element)
   @param cexp the {i gnexp} being evaluated
   @return the result of the function application
*)
and g_factorial env operandl cexp =
	let operand = extract_operand operandl in
	let eoper = eval_expr env operand in
		match eoper with 
			  I(IVal(integer)) -> I(IVal(factorial_ocaml integer))
			| I(INaN)          -> I(INaN)
			| Type_Error(_)	   -> eoper
			| _		   -> Type_Error("Factorial expects operand of type Int, instead recieved " ^ (string_of_gnvalue eoper) 
						      ^ "\n\t\tIn expression: " ^ (string_of_gnexp cexp))
(**
   Returns the numerical negation of the input given in {b operandl}.
   @param env the current execution environment
   @param operandl the list of operands (expected to have one element)
   @param cexp the {i gnexp} being evaluated
   @return the result of the function application
*)
and g_invert env operandl cexp =
	let operand = extract_operand operandl in
	let eoper = eval_expr env operand in
		match eoper with
			  I(IVal(integer)) -> I(IVal(0-integer))
			| I(INaN)          -> I(INaN)
			| R(real)	   -> R(0.0 -. real)
			| Type_Error(_)	   -> eoper
			| _ 		   -> Type_Error("Numerical negation expects operand of type Int or Real, instead recieved " ^ (string_of_gnvalue eoper) 
						      ^ "\n\t\tIn expression: " ^ (string_of_gnexp cexp))
(**
   Returns the logical negation of the input given in {b operandl}.
   @param env the current execution environment
   @param operandl the list of operands (expected to have one element)
   @param cexp the {i gnexp} being evaluated
   @return the result of the function application
*)
and g_not env operandl cexp =
	let operand = extract_operand operandl in
	let eoper = eval_expr env operand in
		match eoper with
			  B(boole)	-> B(not boole)
			| Type_Error(_)	-> eoper
			| _ 		-> Type_Error("Logical negation expects operand of type Boolean, instead recieved " ^ (string_of_gnvalue eoper) 
						      ^ "\n\t\tIn expression: " ^ (string_of_gnexp cexp))
(**
   Returns the car (head) of the input given in {b operandl}. If {b v_list} is true, it will ensure that the cdr (tail) of the input has the form of a list.
   @param v_list determines whether the function should rigorously typecheck the input
   @param env the current execution environment
   @param operandl the list of operands (expected to have one element)
   @param cexp the {i gnexp} being evaluated
   @return the result of the function application
*)
and g_car v_list env operandl cexp =
	let operand = extract_operand operandl in
	let eoper = eval_expr env operand in 
		match eoper with
			  C(ca,cd)	-> if ((not v_list) || is_list cd) then ca else Type_Error("Head expects operand of type [X], instead recieved " 
												   ^ (string_of_gnvalue eoper)  ^ "\n\t\tIn expression: " 
												   ^ (string_of_gnexp cexp))
			| Type_Error(_)	-> eoper
			| _ 		-> Type_Error("Car expects operand of type [X * X], instead recieved " ^ (string_of_gnvalue eoper) 
						      ^ "\n\t\tIn expression: " ^ (string_of_gnexp cexp))
(**
   Returns the cdr (tail) of the input given in {b operandl}. If {b v_list} is true, it will ensure that the cdr (tail) of the input has the form of a list.
   @param v_list determines whether the function should rigorously typecheck the input
   @param env the current execution environment
   @param operandl the list of operands (expected to have one element)
   @param cexp the {i gnexp} being evaluated
   @return the result of the function application
*)
and g_cdr v_list env operandl cexp =
	let operand = extract_operand operandl in
	let eoper = eval_expr env operand in
		match eoper with
			  C(ca,cd)	-> if ((not v_list) || is_list cd) then cd else Type_Error("Tail expects operand of type [X], instead recieved " 
												   ^ (string_of_gnvalue eoper)  ^ "\n\t\tIn expression: " 
												   ^ (string_of_gnexp cexp))
			| Type_Error(_)	-> eoper
			| _ 		-> Type_Error("Cdr expects operand of type [X * X], instead recieved " ^ (string_of_gnvalue eoper) 
						      ^ "\n\t\tIn expression: " ^ (string_of_gnexp cexp))
(**
   Prints the string corresponding to the input given in {b operandl}. Rigorously typechecks the input to ensure it has the form of a string.
   @param env the current execution environment
   @param operandl the list of operands (expected to have one element)
   @param cexp the {i gnexp} being evaluated
   @return {e N} unless an error has occured
*)
and g_print env operandl cexp =
	let operand = extract_operand operandl in
	let eoper = eval_expr env operand in
		match eoper with
			  C(ca,cd)	-> if is_string eoper then ((print_fix ((make_string_string eoper) ^ "\n")); N) 
			  else Type_Error("Print expects operand of type [Char] (aka String), instead recieved " ^ (string_of_gnvalue eoper) 
					  ^ "\n\t\tIn expression: " ^ (string_of_gnexp cexp))
			| Type_Error(_)	-> eoper
			| _ 		-> Type_Error("Print expects operand of type [Char] (aka String), instead recieved " ^ (string_of_gnvalue eoper) 
						      ^ "\n\t\tIn expression: " ^ (string_of_gnexp cexp))

(* --- binary arithmetic operators --- *)
(**
   Returns the sum of the input given in {b operands}.
   @param env the current execution environment
   @param operands the list of operands (expected to have two elements)
   @param cexp the {i gnexp} being evaluated
   @return the result of the function application
*)
and g_add env operands cexp = 
	let (operand1, operand2) = extract_operand_pair operands in
	let eoper = (eval_expr env operand1, eval_expr env operand2) in
		match eoper with
			  (I(IVal(i1)), I(IVal(i2)))	-> I(IVal(i1+i2))
			| (I(INaN), I(_))               -> I(INaN)
			| (I(_), I(INaN))               -> I(INaN)
			| (R(r1), R(r2))        	-> R(r1+.r2)
			| (Type_Error(_),_)     	-> (fst eoper)
			| (_, Type_Error(_))    	-> (snd eoper)
			| _		        	-> Type_Error("Addition expects operands of type Int * Int or Real * Real, instead recieved " 
								      ^ (string_of_op eoper)  ^ "\n\t\tIn expression: " ^ (string_of_gnexp cexp))
(**
   Returns the difference of the input given in {b operands}.
   @param env the current execution environment
   @param operands the list of operands (expected to have two elements)
   @param cexp the {i gnexp} being evaluated
   @return the result of the function application
*)
and g_sub env operands cexp = 
	let (operand1, operand2) = extract_operand_pair operands in
	let eoper = (eval_expr env operand1, eval_expr env operand2) in
		match eoper with
			  (I(IVal(i1)), I(IVal(i2)))	-> I(IVal(i1-i2))
			| (I(INaN), I(_))               -> I(INaN)
			| (I(_), I(INaN))               -> I(INaN)
			| (R(r1), R(r2))        	-> R(r1-.r2)
			| (Type_Error(_),_)     	-> (fst eoper)
			| (_, Type_Error(_))     	-> (snd eoper)
			| _	        		-> Type_Error("Subtraction expects operands of type Int * Int or Real * Real, instead recieved " 
								      ^ (string_of_op eoper)  ^ "\n\t\tIn expression: " ^ (string_of_gnexp cexp))
(**
   Returns the product of the input given in {b operands}.
   @param env the current execution environment
   @param operands the list of operands (expected to have two elements)
   @param cexp the {i gnexp} being evaluated
   @return the result of the function application
*)
and g_mult env operands cexp = 
	let (operand1, operand2) = extract_operand_pair operands in
	let eoper = (eval_expr env operand1, eval_expr env operand2) in
		match eoper with
			  (I(IVal(i1)), I(IVal(i2)))	-> I(IVal(i1*i2))
			| (I(INaN), I(_))               -> I(INaN)
			| (I(_), I(INaN))               -> I(INaN)
			| (R(r1), R(r2))	        -> R(r1*.r2)
			| (Type_Error(_),_)     	-> (fst eoper)
			| (_, Type_Error(_))    	-> (snd eoper)
			| _		        	-> Type_Error("Multiplication expects operands of type Int * Int or Real * Real, instead recieved " 
								      ^ (string_of_op eoper)  ^ "\n\t\tIn expression: " ^ (string_of_gnexp cexp))
(**
   Returns the quotient of the input given in {b operands}.
   @param env the current execution environment
   @param operands the list of operands (expected to have two elements)
   @param cexp the {i gnexp} being evaluated
   @return the result of the function application
*)
and g_div env operands cexp = 
	let (operand1, operand2) = extract_operand_pair operands in
	let eoper = (eval_expr env operand1, eval_expr env operand2) in
		match eoper with
			  (I(IVal(i1)), I(IVal(0)))	-> I(INaN)
			| (I(IVal(i1)), I(IVal(i2)))	-> I(IVal(i1/i2))
			| (I(INaN), I(_))               -> I(INaN)
			| (I(_), I(INaN))               -> I(INaN)
			| (R(r1), R(r2))        	-> R(r1/.r2)
			| (Type_Error(_),_)     	-> (fst eoper)
			| (_, Type_Error(_))     	-> (snd eoper)
			| _			        -> Type_Error("Division expects operands of type Int * Int or Real * Real, instead recieved " 
								      ^ (string_of_op eoper)  ^ "\n\t\tIn expression: " ^ (string_of_gnexp cexp))
(**
   Returns the exponentiation of the input given in {b operands}.
   @param env the current execution environment
   @param operands the list of operands (expected to have two elements)
   @param cexp the {i gnexp} being evaluated
   @return the result of the function application
*)
and g_exp env operands cexp = 
	let (operand1, operand2) = extract_operand_pair operands in
	let eoper = (eval_expr env operand1, eval_expr env operand2) in
		match eoper with
			  (I(IVal(i1)), I(IVal(i2)))	-> I(IVal(exponent_ocaml i1 i2))
			| (I(INaN), I(_))               -> I(INaN)
			| (I(_), I(INaN))               -> I(INaN)
			| (R(r1), R(r2))	        -> R(r1 ** r2)
			| (Type_Error(_),_)     	-> (fst eoper)
			| (_, Type_Error(_))     	-> (snd eoper)
			| _		        	-> Type_Error("Exponentiation expects operands of type Int * Int or Real * Real, instead recieved " 
								      ^ (string_of_op eoper)  ^ "\n\t\tIn expression: " ^ (string_of_gnexp cexp))
(**
   Returns the modulus of the input given in {b operands}.
   @param env the current execution environment
   @param operands the list of operands (expected to have two elements)
   @param cexp the {i gnexp} being evaluated
   @return the result of the function application
*)
and g_mod env operands cexp = 
	let (operand1, operand2) = extract_operand_pair operands in
	let eoper = (eval_expr env operand1, eval_expr env operand2) in
		match eoper with
			  (I(IVal(i1)), I(IVal(i2)))	-> I(IVal(i1 mod i2))
			| (I(INaN), I(_))               -> I(INaN)
			| (I(_), I(INaN))               -> I(INaN)
			| (Type_Error(_),_)     	-> (fst eoper)
			| (_, Type_Error(_))     	-> (snd eoper)
			| _	        		-> Type_Error("Modulus expects operands of type Int * Int, instead recieved "  ^ (string_of_op eoper)  
								      ^ "\n\t\tIn expression: " ^ (string_of_gnexp cexp))

(* --- binary logical operators --- *)
(**
   Determines the equality of the input given in {b operands}.
   @param env the current execution environment
   @param operands the list of operands (expected to have two elements)
   @param cexp the {i gnexp} being evaluated
   @return the result of the function application
*)
and g_eq env operands cexp = 
	let (operand1, operand2) = extract_operand_pair operands in
		g_equal_values (eval_expr env operand1) (eval_expr env operand2)
(**
   Determines the inequality of the input given in {b operands}.
   @param env the current execution environment
   @param operands the list of operands (expected to have two elements)
   @param cexp the {i gnexp} being evaluated
   @return the result of the function application
*)
and g_neq env operands cexp = 
	let (operand1, operand2) = extract_operand_pair operands in
	let rv = (g_equal_values (eval_expr env operand1) (eval_expr env operand2)) in
		match rv with 
			  B(boole)	-> B(not boole)
			| Type_Error(_) -> rv
			| _		-> B(false)
(**
   Checks to see if the parameters are equal based on their type and structure.
   @param eval1 the first operand
   @param eval2 the second operand
   @return a {e B} {i gnvalue} obtained by testing for equality of {b eval1} and {b eval2}
*)
and g_equal_values eval1 eval2 = 
	match (eval1, eval2) with
		  (I(IVal(i1)), I(IVal(i2)))	-> B(i1 = i2)
		| (I(INaN), I(INaN))            -> B(true)
		| (R(r1), R(r2))		-> B(r1 = r2)
		| (B(b1), B(b2))		-> B(b1 = b2)
		| (Ch(s1), Ch(s2))		-> B(s1 = s2)
		| N, N				-> B(true)
		| _, N				-> B(false)
		| N, _ 				-> B(false)
		| (C(a1, b1), C(a2,b2))		-> g_eq_recurse eval1 eval2
		| (F(_,_,_,_), F(_,_,_,_))	
			-> B(eval1 != eval2)
		| (Type_Error(_),_)	-> eval1
		| (_, Type_Error(_))	-> eval2
		| _			-> B(false)
(**
   Recursively checks to see if the {e C} parameters are equal based on their type and structure.
   @param a the first operand
   @param b the second operand
   @return a {e B} {i gnvalue} obtained by testing for equality of {b a} and {b b}
*)
and g_eq_recurse a b =
	match a, b with 
		  C(a1, b1), C(a2, b2) 	-> (	 
			  let pa = g_equal_values a1 a2
			  and pb = g_equal_values b1 b2 in
				  match (pa, pb) with
					    Type_Error(_), _	-> pa
					  | _, Type_Error(_)	-> pb
					  | B(aa), B(ba)	-> B(aa && ba)
					  | _			-> B(false)
		  )
		| _			-> B(false)
(**
   Determines the greater than relationship between the inputs given in {b operands}.
   @param env the current execution environment
   @param operands the list of operands (expected to have two elements)
   @param cexp the {i gnexp} being evaluated
   @return the result of the function application
*)
and g_gt env operands cexp = 
	let (operand1, operand2) = extract_operand_pair operands in
	let eoper = (eval_expr env operand1, eval_expr env operand2) in
		match eoper with
			  (I(IVal(i1)), I(IVal(i2)))	-> B(i1 > i2)
			| (I(INaN), I(IVal(i2)))	-> B(true)
			| (I(_), I(INaN))       	-> B(false)
			| (R(r1), R(r2))		-> B(r1 > r2)
			| (Type_Error(_),_)		-> (fst eoper)
			| (_, Type_Error(_))		-> (snd eoper)
			| _				-> Type_Error("Greater than testing expects operands of type Int * Int or Real * Real, instead recieved "  
								      ^ (string_of_op eoper) ^ "\n\t\tIn expression: " ^ (string_of_gnexp cexp))
(**
   Determines the less than relationship between the inputs given in {b operands}.
   @param env the current execution environment
   @param operandl the list of operands (expected to have two elements)
   @param cexp the {i gnexp} being evaluated
   @return the result of the function application
*)
and g_lt env operands cexp = 
	let (operand1, operand2) = extract_operand_pair operands in
	let eoper = (eval_expr env operand1, eval_expr env operand2) in
		match eoper with
			  (I(IVal(i1)), I(IVal(i2)))	-> B(i1 < i2)
			| (I(INaN), I(_))	        -> B(false)
			| (I(IVal(_)), I(INaN))       	-> B(true)
			| (R(r1), R(r2))		-> B(r1 < r2)
			| (Type_Error(_),_)		-> (fst eoper)
			| (_, Type_Error(_))		-> (snd eoper)
			| _				-> Type_Error("Less than testing expects operands of type Int * Int or Real * Real, instead recieved "  
								      ^ (string_of_op eoper) ^ "\n\t\tIn expression: " ^ (string_of_gnexp cexp))
(**
   Determines the greater than or equal to relationship between the inputs given in {b operands}.
   @param env the current execution environment
   @param operands the list of operands (expected to have two elements)
   @param cexp the {i gnexp} being evaluated
   @return the result of the function application
*)
and g_ge env operands cexp = 
	let (operand1, operand2) = extract_operand_pair operands in
	let eoper = (eval_expr env operand1, eval_expr env operand2) in
		match eoper with
			  (I(IVal(i1)), I(IVal(i2)))	-> B(i1 >= i2)
			| (I(INaN), I(IVal(_))) 	-> B(true)
			| (I(IVal(_)), I(INaN))       	-> B(false)
			| (I(_), I(_))                  -> B(true)
			| (R(r1), R(r2))		-> B(r1 >= r2)
			| (Type_Error(_),_)		-> (fst eoper)
			| (_, Type_Error(_))		-> (snd eoper)
			| _				-> Type_Error("Greater or equal testing expects operands of type Int * Int or Real * Real, instead recieved "
								      ^ (string_of_op eoper) ^ "\n\t\tIn expression: " ^ (string_of_gnexp cexp))
(**
   Determines the less than or equal to relationship between the inputs given in {b operands}.
   @param env the current execution environment
   @param operands the list of operands (expected to have two elements)
   @param cexp the {i gnexp} being evaluated
   @return the result of the function application
*)
and g_le env operands cexp = 
	let (operand1, operand2) = extract_operand_pair operands in
	let eoper = (eval_expr env operand1, eval_expr env operand2) in
		match eoper with
			  (I(IVal(i1)), I(IVal(i2)))	-> B(i1 <= i2)
			| (I(INaN), I(IVal(_))) 	-> B(false)
			| (I(IVal(_)), I(INaN))       	-> B(true)
			| (I(_), I(_))                  -> B(true)
			| (R(r1), R(r2))		-> B(r1 <= r2)
			| (Type_Error(_),_)		-> (fst eoper)
			| (_, Type_Error(_))		-> (snd eoper)
			| _				-> Type_Error("Less or equal testing expects operands of type Int * Int or Real * Real, instead recieved "  
								      ^ (string_of_op eoper) ^ "\n\t\tIn expression: " ^ (string_of_gnexp cexp))
(**
   Determines logical conjunction ("and") relationship between the inputs given in {b operands}. This implements short-circuiting, so if the first
   operand is false, then the second will not be evaluated. Consequently, if the structure of the first operand is incompatible with the function
   (i.e. not a {e B}), causing a type error, the resulting error message will be unable to notify the user of the value of the second operand.
   @param env the current execution environment
   @param operands the list of operands (expected to have two elements)
   @param cexp the {i gnexp} being evaluated
   @return the result of the function application
*)
and g_and env operands cexp = 
	let (operand1, operand2) = extract_operand_pair operands in
	let eoper1 = eval_expr env operand1 in
		match eoper1 with
			  B(false)		-> B(false)
			| B(true)		-> (
				  let eoper2 = eval_expr env operand2 in
					  match eoper2 with
						    B(_)		-> eoper2
						  | Type_Error(_)	-> eoper2
						  | _		-> Type_Error("And testing expects operands of type Boolean * Boolean, " 
									      ^ "instead recieved " ^ (string_of_op (eoper1,eoper2)) ^ "\n\t\tIn expression: " 
									      ^ (string_of_gnexp cexp))
			  )
			| Type_Error(_)		-> eoper1
			| _			-> Type_Error("And testing expects operands of type Boolean * Boolean, instead recieved "  
							      ^ (string_of_gnvalue eoper1) ^ " * X\n\t\tIn expression: " ^ (string_of_gnexp cexp))
(**
   Determines logical disjunction ("or") relationship between the inputs given in {b operands}. This implements short-circuiting, so if the first
   operand is false, then the second will not be evaluated. Consequently, if the structure of the first operand is incompatible with the function
   (i.e. not a {e B}), causing a type error, the resulting error message will be unable to notify the user of the value of the second operand.
   @param env the current execution environment
   @param operands the list of operands (expected to have two elements)
   @param cexp the {i gnexp} being evaluated
   @return the result of the function application
*)
and g_or env operands cexp = 
	let (operand1, operand2) = extract_operand_pair operands in
	let eoper1 = eval_expr env operand1 in
		match eoper1 with
			  B(true)		-> B(true)
			| B(false)		-> (
				  let eoper2 = eval_expr env operand2 in
					  match eoper2 with
						    B(_)		-> eoper2
						  | Type_Error(_)	-> eoper2
						  | _		-> Type_Error("Or testing expects operands of type Boolean * Boolean, " 
									      ^ "instead recieved " ^ (string_of_op (eoper1,eoper2)) ^ "\n\t\tIn expression: " 
									      ^ (string_of_gnexp cexp))
			  )
			| Type_Error(_)		-> eoper1
			| _			-> Type_Error("And testing expects operands of type Boolean * Boolean, instead recieved "  
							      ^ (string_of_gnvalue eoper1) ^ " * X\n\t\tIn expression: " ^ (string_of_gnexp cexp))

(* --- binary list operators --- *)
(**
   Constructs a new cons cell/list from the inputs given in {b operands}. If {b is_lst} is true, will rigorously typecheck the second operand to ensure it has
   the form of a list.
   @param is_lst determines whether this is a list contruction ("attach") or cons cell construction ("cons")
   @param env the current execution environment
   @param operands the list of operands (expected to have two elements)
   @param cexp the {i gnexp} being evaluated
   @return the result of the function application
*)
and g_cons is_lst env operands cexp = 
	let (operand1, operand2) = extract_operand_pair operands in
	let eoper = (eval_expr env operand1, eval_expr env operand2) in
		match eoper with
			| (Type_Error(_),_)	-> (fst eoper)
			| (_, Type_Error(_))	-> (snd eoper)
			| (ca,cd)		-> if is_lst then (if is_list cd then C(ca, cd) else Type_Error("List construction expects operands of type"
														^ " X * [X], instead recieved "  
														^ (string_of_op eoper) 
														^ " * X\n\t\tIn expression: " 
														^ (string_of_gnexp cexp)))
			  else C(ca,cd)


(** 
    Parses and evaluates strings evaluated with the {b eval} builtin
    @param env the current execution environment
    @param operandl a list containing a single element of type {i gnvalue} to be interpreted
    @param cexp the current expression being evaluated
    @return a {i gnvalue} obtained by evaluation of the element of {b operandl}, or a {e Type_Error} if that element is uninterpretable
*)
and g_eval env operandl cexp = 
	let operand = extract_operand operandl in
	let eoper = eval_expr env operand in
		match eoper with
			  C(ca,cd)	-> if is_string eoper 
			                   then (interpret_string ((make_string_string eoper) ^ ";") env) 
			                   else Type_Error("String evaluation expects operand of type [Char] (aka String), instead recieved " 
							   ^ (string_of_gnvalue eoper) ^ "\n\t\tIn expression: " ^ (string_of_gnexp cexp))
			| Type_Error(_)	-> eoper
			| _ 		-> Type_Error("String evaluation expects operand of type [Char] (aka String), instead recieved " 
						      ^ (string_of_gnvalue eoper) ^ "\n\t\tIn expression: " ^ (string_of_gnexp cexp))

(** Extracts a pair of operands from a list containing exactly two elements of {i gnexp} *)
and extract_operand_pair operands = 
	match operands with 
		  a::b::[]	-> (a, b)
		| a::b::_       -> raise TooManyArgs
		| _		-> raise TooFewArgs
(** Converts an operand pair to a string for debug output *)
and string_of_op (opa, opb) = 
	(string_of_gnvalue opa) ^ " * " ^ (string_of_gnvalue opb)

(** Extracts a single operand from a list containing exactly one element of {i gnexp} *)
and extract_operand operands = 
	match operands with 
		  a::[]		-> a
		| []            -> raise TooFewArgs
		| _		-> raise TooManyArgs

(** The {i gntype} for a type variable that can hold Ints or Reals but nothing else, with the name {b alpha}. Useful for the type signatures of 
    numerical functions *)
let num_type_alpha = Exclusive_Type_Variable("alpha",[Basic_Type("Int"); Basic_Type("Real")])

let make_env () = 
	ref (Env (("$$",prev_val)::[]))
and make_tenv () =
	ref (TEnv (("$$",prev_type)::[]))

(** Creates an execution environment preloaded with primitive functions containing the automatic exogenous functions used by Gnarly *)
let setup_global_env = 
	(extend_env (extend_env (extend_env (extend_env (extend_env (extend_env (extend_env (extend_env (extend_env (extend_env (extend_env (extend_env (extend_env 
	(extend_env (extend_env (extend_env (extend_env (extend_env (extend_env (extend_env (extend_env (extend_env (extend_env (extend_env (make_env ()) 
	"read" (PF(g_read)))     
	"print" (PF(g_print)))  
	"not" (PF(g_not))) 
	"cdr" (PF(g_cdr false))) 
	"car" (PF(g_car false))) 
	"neg" (PF(g_invert))) 
	"fact" (PF(g_factorial))) 
	"or" (PF(g_or))) 
	"and" (PF(g_and))) 
	"lt" (PF(g_lt))) 
	"gt" (PF(g_gt))) 
	"le" (PF(g_le))) 
	"ge" (PF(g_ge))) 
	"neq" (PF(g_neq))) 
	"eq" (PF(g_eq))) 
	"mod" (PF(g_mod))) 
	"exp" (PF(g_exp))) 
	"div" (PF(g_div)))  
	"mult" (PF(g_mult))) 
	"sub" (PF(g_sub))) 
	"add" (PF(g_add))) 
	"cons" (PF(g_cons false)))
	"attach" (PF(g_cons true)))
	"eval" (PF(g_eval)))


(** A list of all primitive functions, for use in optimizing simultaneous file interpretation *)
let builtins = ["read"; "print"; "not"; "cdr"; "car"; "neg"; "fact"; "or"; "and"; "lt"; "gt"; "le"; "ge"; "neq"; "eq"; "mod"; "exp"; "div"; "mult";
		"sub"; "add"; "cons"; "attach"; "eval"]

(** Creates a type environment preloaded with type signatures for primitive functions containing the automatic exogenous functions used by Gnarly *)
and setup_global_tenv = 
	(extend_tenv (extend_tenv (extend_tenv (extend_tenv (extend_tenv (extend_tenv (extend_tenv (extend_tenv (extend_tenv (extend_tenv (extend_tenv 
	(extend_tenv (extend_tenv (extend_tenv (extend_tenv (extend_tenv (extend_tenv (extend_tenv (extend_tenv (extend_tenv (extend_tenv (extend_tenv
 	(extend_tenv (extend_tenv (make_tenv ()) 
	"read" (Arrow_Type([], List_Type(List(Basic_Type("Char"))))))
	"print" (Arrow_Type([List_Type(List(Basic_Type("Char")))],List_Type(Empty_List))))
	"not" (Arrow_Type([Basic_Type("Boolean")],Basic_Type("Boolean"))))
	"cdr" (Arrow_Type([Product_Type([Type_Variable("alpha"); Type_Variable("beta")])],Type_Variable("beta"))))
	"car" (Arrow_Type([Product_Type([Type_Variable("alpha"); Type_Variable("beta")])],Type_Variable("alpha"))))
	"neg" (Arrow_Type([num_type_alpha],num_type_alpha)))
	"fact" (Arrow_Type([Basic_Type("Int")],Basic_Type("Int"))))
	"or" (Arrow_Type([Basic_Type("Boolean");Basic_Type("Boolean")],Basic_Type("Boolean"))))
	"and" (Arrow_Type([Basic_Type("Boolean");Basic_Type("Boolean")],Basic_Type("Boolean")))) 
	"lt" (Arrow_Type([num_type_alpha;num_type_alpha],Basic_Type("Boolean"))))
	"gt" (Arrow_Type([num_type_alpha;num_type_alpha],Basic_Type("Boolean"))))
	"le" (Arrow_Type([num_type_alpha;num_type_alpha],Basic_Type("Boolean"))))
	"ge" (Arrow_Type([num_type_alpha;num_type_alpha],Basic_Type("Boolean"))))
	"neq" (Arrow_Type([Type_Variable("alpha");Type_Variable("alpha")],Basic_Type("Boolean")))) 
	"eq" (Arrow_Type([Type_Variable("alpha");Type_Variable("alpha")],Basic_Type("Boolean"))))
	"mod" (Arrow_Type([Basic_Type("Int"); Basic_Type("Int")],Basic_Type("Int"))))
	"exp" (Arrow_Type([num_type_alpha;num_type_alpha],num_type_alpha)))
	"div" (Arrow_Type([num_type_alpha;num_type_alpha],num_type_alpha))) 
	"mult" (Arrow_Type([num_type_alpha;num_type_alpha],num_type_alpha))) 
	"sub" (Arrow_Type([num_type_alpha;num_type_alpha],num_type_alpha)))
	"add" (Arrow_Type([num_type_alpha;num_type_alpha],num_type_alpha)))
	"cons" (Arrow_Type([Type_Variable("alpha");Type_Variable("beta")],Product_Type([Type_Variable("alpha");Type_Variable("beta")]))))
	"attach" (Arrow_Type([Type_Variable("alpha");List_Type(List(Type_Variable("alpha")))],List_Type(List(Type_Variable("alpha"))))))
	"eval" (Arrow_Type([List_Type(List(Basic_Type("Char")))],Dynamic_Type)))

